home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / src / amiga_menu.c < prev    next >
C/C++ Source or Header  |  1992-08-16  |  7KB  |  304 lines
  1. #include <exec/types.h>
  2. #include <libraries/gadtools.h>
  3. #include <intuition/intuition.h>
  4. #include <proto/exec.h>
  5. #include <proto/dos.h>
  6. #include <proto/gadtools.h>
  7. #include <proto/intuition.h>
  8. #include "config.h"
  9. #undef NULL
  10. #include "lisp.h"
  11. #include "amiga.h"
  12.  
  13. static struct Menu *emacs_menu;
  14. static char *emacs_menu_strings;
  15. static APTR win_vi;
  16. struct Library *GadToolsBase;
  17.  
  18. void suspend_menus(void)
  19. {
  20.   if (emacs_win)
  21.     {
  22.       ClearMenuStrip(emacs_win);
  23.       if (win_vi)
  24.     {
  25.       FreeVisualInfo(win_vi);
  26.       win_vi = 0;
  27.     }
  28.     }
  29. }
  30.  
  31. int resume_menus(void)
  32. {
  33.   if (emacs_win && emacs_menu)
  34.     {
  35.       win_vi = GetVisualInfo(emacs_win->WScreen, TAG_END);
  36.  
  37.       if (!win_vi || !LayoutMenus(emacs_menu, win_vi, TAG_END))
  38.     {
  39.       if (win_vi) FreeVisualInfo(win_vi);
  40.       Famiga_delete_menus();
  41.  
  42.       return FALSE;
  43.     }
  44.       SetMenuStrip(emacs_win, emacs_menu);
  45.     }
  46.   return TRUE;
  47. }
  48.  
  49. DEFUN ("amiga-menus", Famiga_menus, Samiga_menus, 1, 1, 0,
  50.   "Define menus for emacs. The argument is a list structured as follows:\n\
  51.    ((menu1-name ((item1-name item1-expr item1-key item1-disabled) ...)\n\
  52.      menu1-disabled) ...)\n\
  53. menu-name is the name of the menu item header.\n\
  54. The menu is disabled if menu-disabled is not nil [optional].\n\
  55. item-name is the name of an item.\n\
  56. The item-expr fields are ignored.\n\
  57. If item-key is nil, no shortcut is allowed.\n\
  58. If item-disabled is not nil, the item is disabled.\n\
  59. If the item information list is nil, a line is drawn in the menu.\n\
  60. item-key & item-disabled are optional.")
  61.   (menus)
  62.      Lisp_Object menus;
  63. {
  64.     Lisp_Object s_menus, s_items;
  65.     int citems, slen;
  66.     char *strdata;
  67.     struct NewMenu *menudata, *mkm;
  68.     struct Lisp_String *name;
  69.  
  70. /*    int i;
  71.     extern int total[], nb[];
  72.  
  73.     for (i = 0; i < 16; i++)
  74.     {
  75.     printf("%d(%d) ", total[i], nb[i]);
  76.     total[i] = nb[i] = 0;
  77.     }
  78.     printf("\n");
  79.     start_count(15);
  80.     for (i = 0; i < 100; i++) { suspend_count(15); resume_count(15); }
  81.     stop_count(15);
  82.     for (i = 0; i < 100; i++) { start_count(14); stop_count(14); }
  83.     printf("100 s/r: %d, 100 s/s: %d\n", total[15], total[14]);
  84.  
  85.     return Qnil;
  86. */
  87.     check_intuition();
  88.  
  89.     /* Check structure of parameter & count # items & menus */
  90.     s_menus = menus;
  91.     citems = slen = 0;
  92.  
  93.     while (!NULL(s_menus))
  94.     {
  95.     struct Lisp_Cons *menu, *menu_cell;
  96.  
  97.     CHECK_CONS(s_menus, 0);
  98.     menu_cell = XCONS(s_menus);
  99.     citems++;
  100.     CHECK_CONS(menu_cell->car, 0); /* Each menu is a list */
  101.     menu = XCONS(menu_cell->car);
  102.  
  103.     CHECK_STRING(menu->car, 0); /* Check name */
  104.     name = XSTRING(menu->car);
  105.     slen += name->size + 1;
  106.     CHECK_CONS(menu->cdr, 0);
  107.  
  108.     menu = XCONS(menu->cdr); /* Check items */
  109.  
  110.     s_items = menu->car;
  111.     while (!NULL(s_items))
  112.     {
  113.         struct Lisp_Cons *item, *item_cell;
  114.  
  115.         CHECK_CONS(s_items, 0);
  116.         item_cell = XCONS(s_items);
  117.         citems++;
  118.         if (!NULL(item_cell->car))
  119.         {
  120.         CHECK_CONS(item_cell->car, 0); /* Each item is a list */
  121.         item = XCONS(item_cell->car);
  122.  
  123.         CHECK_STRING(item->car, 0);
  124.         name = XSTRING(item->car);
  125.         slen += name->size + 1;
  126.  
  127.         if (!NULL(item->cdr)) /* Only name is necessary */
  128.         {
  129.             CHECK_CONS(item->cdr, 0);
  130.             item = XCONS(item->cdr);
  131.  
  132.             /* Expr is arbitrary */
  133.             if (!NULL(item->cdr))
  134.             {
  135.             CHECK_CONS(item->cdr, 0);
  136.             item = XCONS(item->cdr);
  137.  
  138.             /* Check shortcut */
  139.             if (!NULL(item->car))
  140.             {
  141.                 CHECK_NUMBER(item->car, 0);
  142.                 slen += 2;
  143.             }
  144.  
  145.             if (!NULL(item->cdr))
  146.             {
  147.                 CHECK_CONS(item->cdr, 0);
  148.                 item = XCONS(item->cdr);
  149.  
  150.                 /* Check that end of list */
  151.                 if (!NULL(item->cdr)) error("Badly formed item");
  152.             }
  153.             }
  154.         }
  155.         }
  156.         s_items = item_cell->cdr;
  157.     }
  158.     if (!NULL(menu->cdr))
  159.     {
  160.         CHECK_CONS(menu->cdr, 0);
  161.         menu = XCONS(menu->cdr);
  162.         if (!NULL(menu->cdr)) error("Badly formed menu");
  163.     }
  164.     s_menus = menu_cell->cdr;
  165.     }
  166.  
  167.     suspend_menus();
  168.     if (emacs_menu) Famiga_delete_menus();
  169.  
  170.     /* Now create menu structure */
  171.     menudata = (struct NewMenu *)alloca(sizeof(struct NewMenu) * (citems + 1));
  172.     emacs_menu_strings = strdata = (char *)xmalloc(slen);
  173.     mkm = menudata;
  174.     s_menus = menus;
  175.     while (!NULL(s_menus))
  176.     {
  177.     struct Lisp_Cons *menu, *menu_cell;
  178.     struct NewMenu *menu1;
  179.  
  180.     menu_cell = XCONS(s_menus);
  181.     mkm->nm_Type = NM_TITLE;
  182.     menu = XCONS(menu_cell->car);
  183.     name = XSTRING(menu->car);
  184.     strcpy(strdata, name->data);
  185.     mkm->nm_Label = strdata;
  186.     strdata += name->size + 1;
  187.     mkm->nm_CommKey = 0;
  188.     mkm->nm_Flags = 0;
  189.     mkm->nm_MutualExclude = 0;
  190.     menu1 = mkm++;
  191.  
  192.     menu = XCONS(menu->cdr); /* Check items */
  193.  
  194.     s_items = menu->car;
  195.     while (!NULL(s_items))
  196.     {
  197.         struct Lisp_Cons *item, *item_cell;
  198.  
  199.         item_cell = XCONS(s_items);
  200.         mkm->nm_Type = NM_ITEM;
  201.         mkm->nm_CommKey = 0;
  202.         mkm->nm_Flags = 0;
  203.         mkm->nm_MutualExclude = 0;
  204.         if (NULL(item_cell->car))
  205.         {
  206.         mkm->nm_Type = IM_ITEM;
  207.         mkm->nm_Label = NM_BARLABEL;
  208.         }
  209.         else
  210.         {
  211.  
  212.         item = XCONS(item_cell->car);
  213.         name = XSTRING(item->car);
  214.         strcpy(strdata, name->data);
  215.         mkm->nm_Label = strdata;
  216.         strdata += name->size + 1;
  217.  
  218.         if (!NULL(item->cdr)) /* Only name is necessary */
  219.         {
  220.             item = XCONS(item->cdr);
  221.  
  222.             /* Expr is ignored */
  223.  
  224.             if (!NULL(item->cdr))
  225.             {
  226.             item = XCONS(item->cdr);
  227.  
  228.             /* Check shortcut */
  229.             if (!NULL(item->car))
  230.             {
  231.                 mkm->nm_CommKey = strdata;
  232.                 strdata[0] = XFASTINT(item->car);
  233.                 strdata[1] = '\0';
  234.                 strdata += 2;
  235.             }
  236.             if (!NULL(item->cdr))
  237.             {
  238.                 item = XCONS(item->cdr);
  239.                 if (!NULL(item->car))
  240.                 mkm->nm_Flags |= NM_ITEMDISABLED;
  241.             }
  242.             }
  243.         }
  244.         }
  245.         mkm++;
  246.         s_items = item_cell->cdr;
  247.     }
  248.     if (!NULL(menu->cdr))
  249.     {
  250.         menu = XCONS(menu->cdr);
  251.         if (!NULL(menu->car)) menu1->nm_Flags |= NM_MENUDISABLED;
  252.     }
  253.     s_menus = menu_cell->cdr;
  254.     }
  255.     mkm->nm_Type = NM_END;
  256.     mkm->nm_Label = 0;
  257.     mkm->nm_CommKey = 0;
  258.     mkm->nm_Flags = 0;
  259.     mkm->nm_MutualExclude = 0;
  260.     if (!(emacs_menu = CreateMenus(menudata, TAG_END)))
  261.     {
  262.     free(emacs_menu_strings);
  263.     emacs_menu_strings = 0;
  264.     error("Menu couldn't be created");
  265.     }
  266.     if (!resume_menus()) error("Menu couldn't be layed out");
  267.  
  268.     return Qt;
  269. }
  270.  
  271. DEFUN ("amiga-delete-menus", Famiga_delete_menus, Samiga_delete_menus, 0, 0, 0,
  272.        "Remove & free menu strip")
  273.    ()
  274. {
  275.     check_intuition();
  276.  
  277.     suspend_menus();
  278.     if (emacs_menu) FreeMenus(emacs_menu);
  279.     emacs_menu = 0;
  280.     if (emacs_menu_strings) free(emacs_menu_strings);
  281.     emacs_menu_strings = 0;
  282.  
  283.     return Qt;
  284. }
  285.  
  286. void syms_of_amiga_menu(void)
  287. {
  288.     defsubr(&Samiga_delete_menus);
  289.     defsubr(&Samiga_menus);
  290. }
  291.  
  292. void init_amiga_menu(void)
  293. {
  294.     GadToolsBase = OpenLibrary("gadtools.library", 0);
  295.     if (!GadToolsBase) _fail("gadtools.library required");
  296. }
  297.  
  298. void cleanup_amiga_menu(void)
  299. {
  300.   suspend_menus();
  301.   if (emacs_menu) Famiga_delete_menus();
  302.   if (GadToolsBase) CloseLibrary(GadToolsBase);
  303. }
  304.